home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt3sp4.arc / YESNO.PAS < prev   
Pascal/Delphi Source File  |  1985-07-28  |  2KB  |  60 lines
  1. (*----------------------------------------------------------------------*)
  2. (*          YesNo --- Prompt for and read Yes/No question/answer        *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. FUNCTION YesNo( YesNo_Question : AnyStr ) : BOOLEAN;
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Function:   YesNo                                                *)
  10. (*                                                                      *)
  11. (*     Purpose:    Prompt for and read Yes/No question/answer           *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*        Yes_Answer := YesNo( YesNo_Question : AnyStr ) : BOOLEAN;     *)
  16. (*                                                                      *)
  17. (*           YesNo_Question --- Text of Yes/No question to be asked     *)
  18. (*           Yes_Answer     --- Set TRUE if "Yes" answer given, else    *)
  19. (*                              set FALSE.                              *)
  20. (*                                                                      *)
  21. (*      Calls:   None                                                   *)
  22. (*                                                                      *)
  23. (*----------------------------------------------------------------------*)
  24.  
  25. VAR
  26.    Ans_Ch: CHAR;
  27.    X     : INTEGER;
  28.    Y     : INTEGER;
  29.  
  30. BEGIN (* YesNo *)
  31.  
  32.    WRITELN;
  33.  
  34.    X      := WhereX;
  35.    Y      := WhereY;
  36.  
  37.    Ans_Ch := ' ';
  38.  
  39.    REPEAT
  40.  
  41.       GoToXY( X , Y );
  42.       ClrEol;
  43.       WRITE( YesNo_Question );
  44.       READ( Kbd , Ans_Ch );
  45.       Ans_Ch := UpCase( Ans_Ch );
  46.  
  47.    UNTIL( Ans_Ch IN ['Y','N'] );
  48.  
  49.    IF Ans_Ch = 'Y' THEN
  50.       BEGIN
  51.          YesNo := TRUE;
  52.          WRITE('Yes');
  53.       END
  54.    ELSE
  55.       BEGIN
  56.          YesNo := FALSE;
  57.          WRITE('No');
  58.       END;
  59.  
  60. END   (* YesNo *);